home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v9n04.arc
/
GOFISH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-30
|
11KB
|
383 lines
UNIT GoFish;
(**********************)
(**) INTERFACE (**)
(**********************)
USES crt, cards, ListObj;
TYPE
FPP = ^FPlayer;
FHPlayerP = ^FHumanPlayer;
FMPlayerP = ^FMachPlayer;
revealed = ARRAY[0..12] of boolean;
FPlayer = OBJECT (player)
Score : byte;
Rev : revealed;
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
PROCEDURE ShowHand; virtual;
PROCEDURE HideHand; virtual;
{-- Above are overridden, below new for FISH player --}
PROCEDURE LineMsg(S:String);
PROCEDURE PointToMe; virtual;
PROCEDURE UnPointMe; virtual;
FUNCTION GetScore : Word;
PROCEDURE Tell(VAR RevWhat : revealed);
PROCEDURE SetRev(cvalu : byte; RevIt : boolean); virtual;
PROCEDURE ChooseOpponent(opps : list; VAR P : FPP); virtual;
PROCEDURE ChooseCard(VAR Cval : word); virtual;
PROCEDURE AskFor(P : FPP; num : byte);
FUNCTION HaveAny(num : byte) : boolean; virtual;
PROCEDURE GiveTo(num : byte; P : FPP);
PROCEDURE TakeTurn(opps : List; VAR same : boolean;
VAR numl : byte; dek : DeckP); virtual;
END;
FHumanPlayer = OBJECT (FPlayer)
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
PROCEDURE ShowHand; virtual;
PROCEDURE ChooseOpponent(opps : List; VAR P : FPP); virtual;
PROCEDURE ChooseCard(VAR Cval : word); virtual;
END;
FMachPlayer = OBJECT (FPlayer)
CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
DESTRUCTOR done; virtual;
PROCEDURE ChooseOpponent(opps : List; VAR P : FPP); virtual;
PROCEDURE ChooseCard(VAR Cval : word); virtual;
END;
Fish = OBJECT (game)
NumLeft : Byte;
CONSTRUCTOR Init;
DESTRUCTOR done; virtual;
PROCEDURE Play; virtual;
PROCEDURE Display; virtual;
END;
(**********************)
(**) IMPLEMENTATION (**)
(**********************)
(*-methods for FPlayer-------*)
CONSTRUCTOR FPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN
Player.Init(iX, iY, iShow, IDire, iName);
Score := 0; FillChar(Rev, SizeOf(Rev), false);
END;
DESTRUCTOR FPlayer.done; BEGIN player.Done; END;
PROCEDURE FPlayer.ShowHand;
BEGIN
WITH H^ DO BEGIN display; GotoXY(GetX, GetY+5); END;
Write(name, ' : ', score);
END;
PROCEDURE FPlayer.HideHand; BEGIN H^.Hide; END;
PROCEDURE FPlayer.LineMsg(S : String);
BEGIN
GotoXY(30, 25); ClrEOL;
Write(S); Delay(3000);
GotoXY(30, 25); ClrEOL;
END;
PROCEDURE FPlayer.PointToMe;
VAR ro : Byte;
BEGIN
FOR ro := (H^.GetY) TO (H^.GetY+4) DO
BEGIN GotoXY(pred(H^.GetX), ro); Write(#219); END;
END;
PROCEDURE FPlayer.UnPointMe;
VAR ro : Byte;
BEGIN
FOR ro := (H^.GetY) TO (H^.GetY+4) DO
BEGIN GotoXY(pred(H^.GetX), ro); Write(' '); END;
END;
FUNCTION FPlayer.GetScore : Word; BEGIN GetScore := Score; END;
PROCEDURE FPlayer.Tell(VAR RevWhat : revealed);
BEGIN RevWhat := Rev; END;
PROCEDURE FPlayer.SetRev(cvalu : byte; RevIt : boolean);
BEGIN Rev[cvalu] := RevIt; END;
PROCEDURE FPlayer.ChooseOpponent(opps : List; VAR P : FPP);
BEGIN END;
PROCEDURE FPlayer.ChooseCard(VAR Cval : word); BEGIN END;
PROCEDURE FPlayer.AskFor(P : FPP; num : byte);
VAR S : String;
BEGIN
CASE random(4) OF
0 : S := 'gimme all your ';
1 : S := 'please give me your ';
2 : S := 'do you have some ';
3 : S := 'I want your ';
END;
LineMsg(name+' : "'+P^.GetName+', ' + S + pips[num]+'''s"');
END;
FUNCTION FPlayer.HaveAny(num : byte) : boolean;
VAR C : CardP;
BEGIN
HaveAny := FALSE; C := H^.OnBot;
WHILE C <> NIL DO
BEGIN
IF C^.GetRank = num THEN HaveAny := true;
C := H^.NextCard(C);
END;
END;
PROCEDURE FPlayer.GiveTo(num : byte; P : FPP);
VAR C, C1 : CardP;
N : Byte;
BEGIN
N := 0; C := H^.OnBot;
HideHand;
WHILE C <> NIL DO
BEGIN
C1 := H^.NextCard(C);
IF C^.GetRank = num THEN
BEGIN H^.remove(C); P^.TakeCard(C); Inc(N); END;
C := C1;
END;
ShowHand;
LineMsg(Name+' gives '+P^.GetName+' '+char(N+ord('0'))+
' '+pips[num]+'''s');
END;
PROCEDURE FPlayer.TakeTurn(opps : List; VAR same : boolean;
VAR numl : byte; dek : DeckP);
VAR P : FPP;
cvalue : word;
PROCEDURE CheckFour(num : byte);
VAR N : byte;
C, C1 : CardP;
BEGIN
C := H^.OnBot; N := 0;
WHILE C <> NIL DO
BEGIN
IF C^.GetRank = num THEN Inc(N);
C := H^.NextCard(C);
END;
IF N = 4 THEN
BEGIN
Fanfare;
LineMsg(name+' just matched off four '+pips[num]+'''s');
Inc(Score); dec(numl);
SetRev(num, false);
HideHand;
C := H^.OnBot; {-- remove the matched set of 4 --}
WHILE C <> NIL DO
BEGIN
C1 := H^.NextCard(C);
IF C^.GetRank = num THEN
BEGIN H^.remove(C); dispose(C, done); END;
C := C1;
END;
ShowHand;
END;
END;
BEGIN
TextAttr := TextAttr OR $80;
ShowHand;
TextAttr := TextAttr AND $7F;
IF H^.Empty THEN
BEGIN
IF NOT Dek^.empty THEN
BEGIN
LineMsg(Name+' just draws a card.');
TakeCard(dek^.FromTop);
CValue := H^.OnTop^.GetRank;
END
ELSE LineMsg('Sorry, '+name+', no more cards.');
END
ELSE
BEGIN
ChooseOpponent(opps, P);
ChooseCard(CValue);
SetRev(cValue, true);
P^.SetRev(cValue, false);
AskFor(P, CValue);
IF P^.HaveAny(CValue) THEN
BEGIN
Happy; same := true;
P^.GiveTo(CValue, @self);
END
ELSE
BEGIN
Sad; same := false;
LineMsg(P^.GetName+' says "**** GO FISH ****"');
IF NOT Dek^.empty THEN
BEGIN
TakeCard(Dek^.FromTop);
CValue := H^.OnTop^.GetRank;
END;
END;
END;
ShowHand;
CheckFour(CValue);
IF H^.Empty THEN same := false;
END;
(*-methods for FHumanPlayer--*)
CONSTRUCTOR FHumanPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
DESTRUCTOR FHumanPlayer.done; BEGIN FPlayer.done; END;
PROCEDURE FHumanPlayer.ShowHand;
BEGIN H^.Sort(false); FPlayer.ShowHand; END;
PROCEDURE FHumanPlayer.ChooseOpponent(opps : List; VAR P : FPP);
VAR ro : Byte;
CH : char;
PROCEDURE Remember;
VAR N : Byte;
heRev : revealed;
S : String;
BEGIN
P^.Tell(heRev); S := '';
FOR N := 0 to 12 DO IF heRev[N] THEN S := S + pips[N] + ' ';
IF S = '' THEN
LineMsg('You don''t know what '+P^.GetName+' has.')
ELSE LineMsg('You remember that '+P^.GetName+' has '+S);
END;
BEGIN
P := FPP(FirsNotSelf(opps));
REPEAT
P^.PointToMe;
CH := ReadKey;
P^.UnPointMe;
CASE CH OF
#0 : CASE ReadKey OF
#$48 : {up} P := FPP(PrevNotSelf(opps, P));
#$50 : {down} P := FPP(NextNotSelf(opps, P));
END;
'?': Remember;
END;
UNTIL CH = #13;
END;
PROCEDURE FHumanPlayer.ChooseCard(VAR Cval : word);
VAR CH : Char;
C : CardP;
BEGIN
C := CardP(H^.OnBot);
REPEAT
H^.PointToCard(C, up);
CH := ReadKey;
H^.UnPointCard(C, up);
IF CH = #0 THEN
CASE ReadKey OF {left or right arrow}
#$4B : IF H^.PrevCard(C) <> NIL THEN C := H^.PrevCard(C);
#$4D : IF H^.NextCard(C) <> NIL THEN C := H^.NextCard(C);
END;
UNTIL CH = #13;
Cval := C^.GetRank;
END;
(*-methods for FMachPlayer---*)
CONSTRUCTOR FMachPlayer.Init(iX, iY : Word; iShow : decision;
iDire : direction; iName : string);
BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
DESTRUCTOR FMachPlayer.done; BEGIN FPlayer.done; END;
PROCEDURE FMachPlayer.ChooseOpponent(opps : List; VAR P : FPP);
VAR N : byte;
BEGIN
P := FPP(FirsNotSelf(opps));
FOR N := 1 to random(6) DO P := FPP(NextNotSelf(opps, P));
END;
PROCEDURE FMachPlayer.ChooseCard(VAR Cval : word);
VAR N : byte;
C : CardP;
BEGIN
C := CardP(H^.OnBot);
FOR N := 1 to random(H^.NumInPile) DO C := H^.NextCard(C);
cval := C^.GetRank;
END;
(*-methods for Fish----------*)
CONSTRUCTOR Fish.Init;
BEGIN
Game.Init($1F); NumLeft := 13;
New(D, Init(0, 0, $1F)); D^.Shuffle;
END;
DESTRUCTOR Fish.done; BEGIN game.done; END;
PROCEDURE Fish.Display;
VAR P : PlayerP;
BEGIN
TextAttr := TableColor; ClrScr;
P := PlayerP(Players.Firs);
WHILE P <> NIL DO
BEGIN
P^.ShowHand;
P := PlayerP(players.next(P));
END;
END;
PROCEDURE Fish.Play;
VAR same : boolean;
PROCEDURE SeeWhoWon;
VAR FP : FPP;
Max, N : Word;
S : String;
BEGIN
Max := 0; S := ''; N := 0;
FP := FPP(players.Firs);
WHILE FP <> NIL DO
BEGIN
IF FP^.GetScore > Max THEN
BEGIN
Max := FP^.GetScore; S := FP^.GetName; N := 1;
END
ELSE IF FP^.GetScore = Max THEN
BEGIN
S := S+' & '+FP^.GetName; Inc(N);
END;
FP := FPP(Players.next(FP));
END;
GotoXY(1, 25); ClrEOL;
Write(S,' got ',Max,' points: ');
CASE N OF
1: Write('A WINNER!');
2: Write('a tie');
3: Write('a 3-way tie');
END;
END;
BEGIN
IF WhoseTurn = NIL THEN Exit;
REPEAT
FPP(WhoseTurn)^.TakeTurn(players, same, NumLeft, D);
IF NOT same THEN WhoseTurn := FPP(players.NextCirc(WhoseTurn));
UNTIL NumLeft = 0;
SeeWhoWon;
END;
END.